home *** CD-ROM | disk | FTP | other *** search
/ Visual Basic Source Code / Visual Basic Source Code.iso / vbsource / richto1a / frmmain.frm (.txt) next >
Encoding:
Visual Basic Form  |  1999-10-03  |  9.6 KB  |  251 lines
  1. VERSION 5.00
  2. Object = "{3B7C8863-D78F-101B-B9B5-04021C009402}#1.2#0"; "RICHTX32.OCX"
  3. Begin VB.Form frmMain 
  4.    Caption         =   "Rich To HTML"
  5.    ClientHeight    =   3600
  6.    ClientLeft      =   60
  7.    ClientTop       =   345
  8.    ClientWidth     =   4245
  9.    LinkTopic       =   "Form1"
  10.    ScaleHeight     =   3600
  11.    ScaleWidth      =   4245
  12.    StartUpPosition =   3  'Windows Default
  13.    Begin VB.TextBox txtHTML 
  14.       BeginProperty Font 
  15.          Name            =   "Arial"
  16.          Size            =   9.75
  17.          Charset         =   0
  18.          Weight          =   400
  19.          Underline       =   0   'False
  20.          Italic          =   0   'False
  21.          Strikethrough   =   0   'False
  22.       EndProperty
  23.       Height          =   735
  24.       Left            =   0
  25.       MultiLine       =   -1  'True
  26.       ScrollBars      =   2  'Vertical
  27.       TabIndex        =   4
  28.       Top             =   2040
  29.       Width           =   4215
  30.    End
  31.    Begin VB.CommandButton cmdConvert 
  32.       Caption         =   "Convert"
  33.       Height          =   375
  34.       Left            =   1560
  35.       TabIndex        =   1
  36.       Top             =   1200
  37.       Width           =   1215
  38.    End
  39.    Begin RichTextLib.RichTextBox rtbRichText 
  40.       Height          =   735
  41.       Left            =   0
  42.       TabIndex        =   0
  43.       Top             =   240
  44.       Width           =   4215
  45.       _ExtentX        =   7435
  46.       _ExtentY        =   1296
  47.       _Version        =   393217
  48.       TextRTF         =   $"frmMain.frx":0000
  49.    End
  50.    Begin VB.Label lblHTML 
  51.       BackStyle       =   0  'Transparent
  52.       Caption         =   "HTML:"
  53.       Height          =   255
  54.       Left            =   0
  55.       TabIndex        =   3
  56.       Top             =   1760
  57.       Width           =   615
  58.    End
  59.    Begin VB.Line lneSep2 
  60.       BorderColor     =   &H80000003&
  61.       Index           =   1
  62.       X1              =   0
  63.       X2              =   4200
  64.       Y1              =   1670
  65.       Y2              =   1670
  66.    End
  67.    Begin VB.Line lneSep2 
  68.       BorderColor     =   &H00FFFFFF&
  69.       Index           =   0
  70.       X1              =   0
  71.       X2              =   4200
  72.       Y1              =   1680
  73.       Y2              =   1680
  74.    End
  75.    Begin VB.Line lneSep 
  76.       BorderColor     =   &H80000003&
  77.       Index           =   1
  78.       X1              =   0
  79.       X2              =   4200
  80.       Y1              =   1070
  81.       Y2              =   1070
  82.    End
  83.    Begin VB.Line lneSep 
  84.       BorderColor     =   &H00FFFFFF&
  85.       Index           =   0
  86.       X1              =   0
  87.       X2              =   4200
  88.       Y1              =   1080
  89.       Y2              =   1080
  90.    End
  91.    Begin VB.Label lblRichText 
  92.       BackStyle       =   0  'Transparent
  93.       Caption         =   "Rich Text:"
  94.       Height          =   255
  95.       Left            =   0
  96.       TabIndex        =   2
  97.       Top             =   0
  98.       Width           =   1215
  99.    End
  100. Attribute VB_Name = "frmMain"
  101. Attribute VB_GlobalNameSpace = False
  102. Attribute VB_Creatable = False
  103. Attribute VB_PredeclaredId = True
  104. Attribute VB_Exposed = False
  105. '**********************************************************
  106. '*            Rich To HTML by Joseph Huntley              *
  107. '*               joseph_huntley@email.com                 *
  108. '*                http://joseph.vr9.com                   *
  109. '*                                                        *
  110. '*  Made:  October 4, 1999                                *
  111. '*  Level: Beginner                                       *
  112. '**********************************************************
  113. '*   The form here are only used to demonstrate how to    *
  114. '* use the function 'RichToHTML'. You may copy the        *
  115. '* function into your project for use. If you need any    *
  116. '* help please e-mail me.                                 *
  117. '**********************************************************
  118. '* Notes: None                                            *
  119. '**********************************************************
  120. Function RichToHTML(rtbRichTextBox As RichTextLib.RichTextBox, Optional lngStartPosition As Long, Optional lngEndPosition As Long) As String
  121. '**********************************************************
  122. '*            Draw Percent by Joseph Huntley              *
  123. '*               joseph_huntley@email.com                 *
  124. '*                http://joseph.vr9.com                   *
  125. '**********************************************************
  126. '*   You may use this code freely as long as credit is    *
  127. '* given to the author, and the header remains intact.    *
  128. '**********************************************************
  129. '--------------------- The Arguments -----------------------
  130. 'rtbRichTextBox     - The rich textbox control to convert.
  131. 'lngStartPosition   - The character position to start from.
  132. 'lngEndPosition     - The character position to end at.
  133. '-----------------------------------------------------------
  134. 'Returns:     The rich text converted to HTML.
  135. 'Description: Converts rich text to HTML.
  136. Dim blnBold As Boolean, blnUnderline As Boolean, blnStrikeThru As Boolean
  137. Dim blnItalic As Boolean, strLastFont As String, lngLastFontColor As Long
  138. Dim strHTML As String, lngColor As Long, lngRed As Long, lngGreen As Long
  139. Dim lngBlue As Long, lngCurText As Long, strHex As String, intLastAlignment As Integer
  140. Const AlignLeft = 0, AlignRight = 1, AlignCenter = 2
  141. 'check for lngStartPosition ad lngEndPosition
  142. If IsMissing(lngStartPosition&) Then lngStartPosition& = 0
  143. If IsMissing(lngEndPosition&) Then lngEndPosition& = Len(rtbRichTextBox.Text)
  144. lngLastFontColor& = -1 'no color
  145.    For lngCurText& = lngStartPosition& To lngEndPosition&
  146.        rtbRichTextBox.SelStart = lngCurText&
  147.        rtbRichTextBox.SelLength = 1
  148.           If intLastAlignment% <> rtbRichTextBox.SelAlignment Then
  149.              intLastAlignment% = rtbRichTextBox.SelAlignment
  150.               
  151.                 Select Case rtbRichTextBox.SelAlignment
  152.                    Case AlignLeft: strHTML$ = strHTML$ & "<p align=left>"
  153.                    Case AlignRight: strHTML$ = strHTML$ & "<p align=right>"
  154.                    Case AlignCenter: strHTML$ = strHTML$ & "<p align=center>"
  155.                 End Select
  156.                 
  157.           End If
  158.           If blnBold <> rtbRichTextBox.SelBold Then
  159.                If rtbRichTextBox.SelBold = True Then
  160.                  strHTML$ = strHTML$ & "<b>"
  161.                Else
  162.                  strHTML$ = strHTML$ & "</b>"
  163.                End If
  164.              blnBold = rtbRichTextBox.SelBold
  165.           End If
  166.           If blnUnderline <> rtbRichTextBox.SelUnderline Then
  167.                If rtbRichTextBox.SelUnderline = True Then
  168.                  strHTML$ = strHTML$ & "<u>"
  169.                Else
  170.                  strHTML$ = strHTML$ & "</u>"
  171.                End If
  172.              blnUnderline = rtbRichTextBox.SelUnderline
  173.           End If
  174.           If blnItalic <> rtbRichTextBox.SelItalic Then
  175.                If rtbRichTextBox.SelItalic = True Then
  176.                  strHTML$ = strHTML$ & "<i>"
  177.                Else
  178.                  strHTML$ = strHTML$ & "</i>"
  179.                End If
  180.              blnItalic = rtbRichTextBox.SelItalic
  181.           End If
  182.           If blnStrikeThru <> rtbRichTextBox.SelStrikeThru Then
  183.                If rtbRichTextBox.SelStrikeThru = True Then
  184.                  strHTML$ = strHTML$ & "<s>"
  185.                Else
  186.                  strHTML$ = strHTML$ & "</s>"
  187.                End If
  188.              blnStrikeThru = rtbRichTextBox.SelStrikeThru
  189.           End If
  190.          If strLastFont$ <> rtbRichTextBox.SelFontName Then
  191.             strLastFont$ = rtbRichTextBox.SelFontName
  192.             strHTML$ = strHTML$ + "<font face=""" & strLastFont$ & """>"
  193.          End If
  194.          If lngLastFontColor& <> rtbRichTextBox.SelColor Then
  195.             lngLastFontColor& = rtbRichTextBox.SelColor
  196.             
  197.             ''Get hexidecimal value of color
  198.             strHex$ = Hex(rtbRichTextBox.SelColor)
  199.             strHex$ = String$(6 - Len(strHex$), "0") & strHex$
  200.             strHex$ = Right$(strHex$, 2) & Mid$(strHex$, 3, 2) & Left$(strHex$, 2)
  201.             
  202.             strHTML$ = strHTML$ + "<font color=#" & strHex$ & ">"
  203.         End If
  204.      strHTML$ = strHTML$ + rtbRichTextBox.SelText
  205.    Next lngCurText&
  206. RichToHTML = strHTML$
  207. End Function
  208. Function RGBtoHEX(lngColor As Long)
  209. Dim strHex As String
  210. 'get hexidecimal value
  211. strHex$ = Hex(lngColor&)
  212. 'fill in
  213. strHex$ = String$(6 - Len(strHex$), "0") & strHex$
  214. 'swap first and third hex values.
  215. strHex$ = Right$(strHex$, 2) & Mid$(strHex$, 3, 2) & Left$(strHex$, 2)
  216. RGBtoHEX = strHex$
  217. End Function
  218. Private Sub cmdConvert_Click()
  219.   txtHTML.Text = RichToHTML(rtbRichText, 0&, Len(rtbRichText.Text))
  220. End Sub
  221. Private Sub Form_Load()
  222.   'set the text in rtbRichTextBox
  223.   With rtbRichText
  224.      .Text = "Click on the 'convert' button to convert this richtext to HTML."
  225.      .SelStart = 0
  226.      .SelLength = Len(.Text)
  227.      .SelFontName = "Arial"
  228.      .SelFontSize = 10
  229.      .SelAlignment = rtfCenter
  230.      .SelStart = InStr(.Text, "convert") - 1
  231.      .SelLength = Len("convert")
  232.      .SelFontName = "Courier New"
  233.      .SelColor = vbBlue
  234.      .SelStart = InStr(.Text, "HTML") - 1
  235.      .SelLength = 4
  236.      .SelFontName = "Courier New"
  237.      .SelUnderline = True
  238.      .SelStart = .SelStart + 1
  239.      .SelLength = 1
  240.      .SelColor = vbRed
  241.      .SelStart = .SelStart + 1
  242.      .SelLength = 1
  243.      .SelColor = vbBlue
  244.      .SelStart = .SelStart + 1
  245.      .SelLength = 1
  246.      .SelColor = vbGreen
  247.      .SelStart = 0
  248.      .SelLength = 0
  249.   End With
  250. End Sub
  251.